home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / pop.tcl.z / pop.tcl
Text File  |  2002-07-08  |  2KB  |  90 lines
  1. # pop.tcl
  2. # POP3 support for exmh
  3.  
  4. proc Pop_GetPassword {host} {
  5.     global pop
  6.     if {[info exist pop($host,password)]} {
  7.     set pop(password) $pop($host,password)
  8.     return
  9.     }
  10.     if {[file exists ~/.netrc]} {
  11.     if {[catch {open ~/.netrc} in]} {
  12.         Exmh_Status "Warning - can't read ~/.netrc: $in"
  13.     } else {
  14.         set X [read $in]
  15.         set tokens {}
  16.         foreach token [split $X] {
  17.         if {[string length $token] == 0} {
  18.             continue
  19.         }
  20.         lappend tokens $token
  21.         }
  22.         set state nohost
  23.         foreach {key value} $tokens {
  24.         switch $state {
  25.             nohost {
  26.             if {[string compare $key machine] == 0 &&
  27.                 [string compare $value $host] == 0} {
  28.                 set state gothost
  29.             }
  30.             }
  31.             gothost {
  32.             if {[string compare $key machine] == 0} {
  33.                 break    ;# Done with this host
  34.             }
  35.             set pop($host,$key) $value
  36.             }
  37.         }
  38.         }
  39.     }
  40.     # See if the .netrc has values already
  41.     if {[info exist pop($host,password)]} {
  42.         set pop(password) $pop($host,password)
  43.         return
  44.     }
  45.     }
  46.  
  47.     # Nothing in .netrc - prompt the user, and save the info if desired
  48.  
  49.     Pop_Dialog $host
  50. }
  51.  
  52. proc Pop_Dialog {host} {
  53.     global pop
  54.     set t .pop
  55.     set but .pop.but
  56.     if {[Exwin_Toplevel $t "POP3 Mail Login [tk appname]" Pop]} {
  57.     label $t.label -text "Enter your user ID and password for\nMail server $host"
  58.     pack $t.label -side top -fill x
  59.     Widget_BeginEntries
  60.     Widget_LabeledEntry $t.user UserID pop($host,login)
  61.     Widget_LabeledEntry $t.pass Password pop($host,password)
  62.     $t.pass.entry config -show *
  63.     # Focus on password as the common case, unless we don't know login
  64.     if {[string length $pop($host,login)] == 0} {
  65.         focus $t.user.entry
  66.     } else {
  67.         focus $t.pass.entry
  68.     }
  69.     Widget_AddBut $but ok "OK" {PopOK} {left padx 1 filly}
  70.     bind $t <Destroy> {set pop(done) 0}
  71.     bind $t.user.entry <Return> "focus $t.pass.entry ; break"
  72.     bind $t.pass.entry <Return> "PopOK"
  73.     }
  74.     set pop(done) 0
  75.     vwait pop(done)
  76.  
  77.     # Destroy this out because it is specific to a host, and they
  78.     # might have multiple hosts.
  79.  
  80.     destroy $t
  81.  
  82.     set pop(password) $pop($host,password)
  83. }
  84.  
  85. proc PopOK {} {
  86.     global pop
  87.     set pop(done) 1
  88.     wm withdraw .pop
  89. }
  90.